home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / epistat.arc / RATEADJ.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-18  |  3.8 KB  |  74 lines
  1. 1  REM             DIRECT AND INDIRECT RATE ADJUSTMENT
  2. 2  REM             Written by Tracy L. Gustafson, M.D.
  3. 3  REM             Round Rock, Texas. Version 2.0, 1983
  4. 5  DEF SEG=&H40
  5. 6  A=PEEK(&H17): IF NOT(A AND &H20) THEN POKE &H17,(A AND (NOT &H20)) OR &H20
  6. 7  DEF SEG: KEY OFF: SCREEN 0,0: WIDTH 80: COLOR 7,0,1
  7. 10  CLEAR: OPTION BASE 1: DEFINT A-C,N,T,Z: DEFSTR D
  8. 20  CLS: PRINT TAB(20);"KEY";STRING$(28,205);"CLOSE"
  9. 25  PRINT TAB(20);"OPEN CALCULATING ADJUSTED RATES OPEN"
  10. 30  PRINT TAB(20);"SCREEN";STRING$(28,205);"LOAD"
  11. 40  PRINT: PRINT TAB(6);: INPUT "What is the name of the DATAFILE you wish to analyze?  ",FILE$
  12. 45  ON ERROR GOTO 500
  13. 50  OPEN FILE$ FOR INPUT AS #1: INPUT #1, A,C
  14. 70  DIM D(A,C),CS(A,C),N$(A),X(A),X2(A),SD(A),MD(A),T(A)
  15. 80  FOR T=1 TO A: INPUT #1, T(T): NEXT
  16. 90  FOR T=1 TO A: FOR Z=1 TO C: INPUT #1, D(T,Z): NEXT: NEXT
  17. 100  FOR T=1 TO A: FOR Z=1 TO T(T): INPUT #1, CS(T,Z): NEXT: NEXT
  18. 110  FOR T=1 TO A: INPUT #1, N$(T),X(T),X2(T),MD(T),SD(T): NEXT: CLOSE #1:PRINT
  19. 115  PRINT TAB(5);: INPUT "Do you want the DIRECT or INDIRECT adjustment method? (D or I)  ",A$
  20. 120  PRINT: IF A$="D" OR A$="d" THEN 130 ELSE IF A$="i" OR A$="I" THEN 200 ELSE BEEP: GOTO 115
  21. 130  INPUT;"Enter the SAMPLE NUMBER of the study rates to be adjusted:   ",NS1
  22. 135  IF NS1<=A THEN PRINT " `";N$(NS1);"'" ELSE GOSUB 490: GOTO 130
  23. 140  INPUT;"Enter the SAMPLE NUMBER of the standard population figures:  ",NS2
  24. 145  IF NS2<=A THEN PRINT " `";N$(NS2);"'": PRINT ELSE GOSUB 490: GOTO 140
  25. 150  IF T(NS1)<>T(NS2) THEN GOSUB 495: GOTO 130
  26. 155  INPUT "Rates in the study group are given per what number?  ",RD
  27. 160  SR=0: N=T(NS1)
  28. 170  FOR Z=1 TO N: SR=SR+VAL(D(NS1,Z))*VAL(D(NS2,Z)): NEXT
  29. 180  SAR=SR/X(NS2): PRINT :PRINT
  30. 185  PLAY "MB T160 L32 N8 N12 N15 N20 N24 N27 N32 N36 N39 N44... N27 L5 N8"
  31. 190  COLOR 0,7: PRINT TAB(15);"Direct-adjusted rate = ";SAR;"per";RD;TAB(75): COLOR 7,0: PRINT
  32. 195  PRINT: PRINT "Remember, if the number of cases in any cell is < 5, then";
  33. 196  PRINT TAB(30);"indirect rate adjustment may be more appropriate.": GOTO 470
  34. 200  INPUT;"Enter the SAMPLE NUMBER of the study population figures:   ",NS1
  35. 205  IF NS1<=A THEN PRINT " `";N$(NS1);"'" ELSE GOSUB 490: GOTO 200
  36. 210  INPUT;"Enter the SAMPLE NUMBER of the standard population rates:  ",NS2
  37. 215  IF NS2<=A THEN PRINT " `";N$(NS2);"'": PRINT ELSE GOSUB 490: GOTO 210
  38. 220  IF T(NS1)<>T(NS2) THEN GOSUB 495: GOTO 200
  39. 230  INPUT "Rates in the standard population are given per what number? ",RD
  40. 240  E=0: N=T(NS1)
  41. 250  FOR Z=1 TO N: E=E+VAL(D(NS1,Z))*VAL(D(NS2,Z)): NEXT
  42. 260  E=E/RD: PRINT :PRINT: PRINT TAB(5);
  43. 270  PRINT "How many cases were observed in the study group `";N$(NS1);: INPUT "' ?  ",NO
  44. 280  PRINT: PRINT TAB(8);"Expected number of cases in the study group =";E
  45. 290  PRINT: COLOR 0,7: PRINT TAB(15);"Observed to expected ratio = ";NO/E;TAB(75);: COLOR 7,0
  46. 292  COLOR 23: PRINT: PRINT: AP=CSRLIN:PRINT TAB(25);"CALCULATING PROBABILITY";
  47. 295  AF=0: CO=NO: CE=0: IF E<CO THEN CO=CO-1: AF=1
  48. 300  IF NO>1000 THEN 360
  49. 310  IF CO=0 THEN SF=1 ELSE SF=E+1
  50. 320  F=E: FOR Z=2 TO CO: F=F*E/Z: IF F>1E+22 THEN F=F*0: SF=SF* 0: CE=CE+1
  51. 325  IF F<0 THEN 330 ELSE SF=SF+F: NEXT Z
  52. 330  SL=LOG(SF)-E+CE*50: IF SL>80 THEN P=0 ELSE P=EXP(SL)*2
  53. 340  IF AF=1 THEN P=2-P
  54. 350  GOTO 410
  55. 360  X=(NO-E)*(NO-E)/E: IF X>31 THEN P=0: GOTO 410
  56. 370  R=1.77245: S=1: I=1: K=((X/2)^(0.5)*2)/(EXP(X/2)*R): B=3
  57. 380  I=I*X/B: S=S+I: B=B+2: IF I>0 THEN 380
  58. 400  P=1-K*S
  59. 410  PLAY "MB T160 L32 N8 N12 N15 N20 N24 N27 N32 N36 N39 N44... N27 L5 N8"
  60. 430  COLOR 0,7: LOCATE AP,1: PRINT TAB(6);"The probability of observing ";NO;" or ";
  61. 440  IF AF=1 THEN PRINT "more cases ="; ELSE PRINT "fewer cases =";
  62. 450  IF P<=9E-09 THEN PRINT " < 10 (-8)"; ELSE IF P>=0.95 THEN PRINT " > .95"; ELSE PRINT P;
  63. 455  PRINT TAB(75): COLOR 7,0: PRINT
  64. 460  IF NO>100 THEN PRINT:PRINT TAB(5);"Remember, the Poisson calculation of probability":PRINT TAB(20);"may not be applicable when the observed rate is > 5% ."
  65. 470  PRINT:PRINT:INPUT "  Do you want to perform another rate adjustment using this DATAFILE?  ",A$
  66. 480  IF A$="y" OR A$="Y" THEN CLS: GOTO 115
  67. 485  END
  68. 490  BEEP: PRINT TAB(15);"This datafile has only";A;"samples.": RETURN
  69. 495  IF T(NS1)<>T(NS2) THEN PRINT:PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(37);"direct rate adjustment cannot be performed.":RETURN
  70. 500  BEEP: PRINT: IF ERL=50 AND ERR=53 THEN PRINT: PRINT TAB(13); "I cannot find a file by that name on drive "; ELSE 530
  71. 510  IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE DR$="A:"
  72. 520  PRINT DR$: PRINT "Your files are:": FILES DR$+"*.*": RESUME 40
  73. 530  ON ERROR GOTO 0
  74.